home *** CD-ROM | disk | FTP | other *** search
/ Whiteline: Alpha / Whiteline Alpha.iso / progtool / modula2 / lpr / inout.mod < prev    next >
Encoding:
Modula Implementation  |  1994-09-22  |  11.6 KB  |  399 lines
  1. IMPLEMENTATION MODULE InOut;
  2.  
  3. (*   Input/output facilities as defined by N.Wirth    *)
  4.  
  5. (* Mostly, "local" comments in the text are either at the same line
  6.    or just below the line(s) they concern.                      *)
  7.  
  8.  
  9.  IMPORT Conversions, GEMDOS, FileSystem, Filename, Terminal;
  10.  FROM SYSTEM IMPORT LONG, SHORT;
  11.  
  12.   TYPE   String = ARRAY [0..80] OF CHAR;
  13.          StKind = (string, line);
  14.            (* selects ReadString or ReadLine: *)
  15.  
  16.   CONST BS  =  10C; (* BackSpace *)
  17.         LF  =  12C; (* LineFeed  *)
  18.         CR  =  15C; (* Carrige Return *)
  19.         NUL =  0C;  (* ASCII.NUL *)
  20.  
  21. TYPE   Stream  = (FILE,   (* file *)
  22.                   CON,    (* screen and keyboard *)
  23.                   AUX,    (* serial port   (RS 232) *)
  24.                   PRN     (* parallel port (printer *));
  25.                   
  26. VAR In, Out : Stream;
  27.     InFile, OutFile : FileSystem.File;
  28.  
  29.   PROCEDURE RdStr (* called by ReadString and ReadLine *)
  30.                   (VAR s : ARRAY OF CHAR; (* The String *)
  31.                    VAR i : INTEGER; (* index of s,
  32.                                        returned value:
  33.                                        index of first element not read to *)
  34.                     kind : StKind (* select ReadString or ReadLine *) );
  35.  
  36.   VAR j, max : INTEGER;
  37.                 (* max is type INTEGER to be compatible to index i,
  38.                    which must be able to take the value -1 *)
  39.   PROCEDURE Pt() : BOOLEAN; (* is actual element of s printable ? *)
  40.     BEGIN
  41.       IF kind = line THEN RETURN s[i]>=" " ELSE RETURN s[i]>" " END
  42.     END Pt;
  43.   BEGIN
  44.     max:=HIGH(s);
  45.     FOR j:=0 TO max DO s[j]:=NUL END; (* reset all elements of s *)
  46.     i:=0; 
  47.     IF In=CON THEN
  48.       Terminal.ReadString(s);
  49.       WHILE ~Pt() DO INC(i) END;
  50.       j:=0;  
  51.       WHILE (i<=max) & Pt() DO s[j]:=s[i]; INC(i); INC(j) END;
  52.       i:=j;
  53.       s[i]:=NUL;
  54.       Done:=TRUE
  55.     ELSE  
  56.       REPEAT Read(s[i]) UNTIL Pt() OR ~Done;
  57.         (* skip leading not printable characters *)
  58.       IF Done (* not end of file *) THEN
  59.         LOOP
  60.           INC(i);
  61.           Done:=i<max; (* S[max] left for NUL *) IF ~Done THEN EXIT END;
  62.           Read(s[i]);                            IF ~Done THEN EXIT END;
  63.           IF ~Pt() (* not printable *) THEN EXIT END
  64.         END (* LOOP *)
  65.       END
  66.     END;
  67.     IF ~Done THEN s[i]:=NUL END;
  68.     termCH:=s[i]; (* define termCH *)
  69.   END RdStr;
  70.  
  71.   PROCEDURE Length (* of "short" string *)
  72.                    ( VAR S : ARRAY OF CHAR) : CARDINAL;
  73.   VAR n : INTEGER;
  74.   BEGIN
  75.     n:=0;
  76.     WHILE (S[n]>" ")&(n<HIGH(S))
  77.       (* printable and not end of array S *)
  78.     DO INC(n) END;
  79.     IF S[n]>" "
  80.       (* last element of S is printable, and length(string)=length(array *)
  81.     THEN INC(n) END;
  82.     RETURN n
  83.   END Length;
  84.  
  85.   PROCEDURE equ( S, T : ARRAY OF CHAR) : BOOLEAN;
  86.                  (* "short" string S = "short" string T *)
  87.   VAR n : CARDINAL;
  88.   BEGIN
  89.     IF Length(S)#Length(T) THEN RETURN FALSE END;
  90.       (* False if the two length are not equal *)
  91.     FOR n:=0 TO Length(S)-1 DO
  92.       IF S[n]#T[n] THEN RETURN FALSE END
  93.         (* False if any two elemnts with same indices are different *)
  94.     END;
  95.     RETURN TRUE (* all elements are equal *)
  96.   END equ;
  97.  
  98.   PROCEDURE ReqName(VAR name : ARRAY OF CHAR);
  99.     (* request a stream name;
  100.        called by the Open... procedures *)
  101.     VAR
  102.       F, Fn  : Filename.filename;
  103.       i      : INTEGER;
  104.       j      : CARDINAL;
  105.       Wild, Point : BOOLEAN;
  106.     BEGIN
  107.       FOR j:=0 TO Length(name) DO
  108.         IF (name[j]=':') & (i#1) THEN name[j]:='?' END;
  109.           (* leave only ':' at second position of name *)
  110.         CASE name[j] OF
  111.           0C  .. ')' : name[j]:='?'; |
  112.           '+' .. '-' : name[j]:='?'; |
  113.           '/'        : name[j]:='?'; |
  114.           ';' .. '@' : name[j]:='?'; |
  115.           '['        : name[j]:='?'; |
  116.           ']' .. '^' : name[j]:='?'; |
  117.           140C       : name[j]:='?'; |
  118.           '{' ..177C : name[j]:='?'; |
  119.           233C..237C : name[j]:='?'; |
  120.           246C..257C : name[j]:='?'; |
  121.           271C..277C : name[j]:='?'; |
  122.           302C..377C : name[j]:='?'
  123.         ELSE
  124.           (* leave only digits, letters, '_', '*', '?', '.', ':', and '\' *)
  125.         END
  126.       END;
  127.       Point:=FALSE;
  128.       FOR j:=Length(name) TO 0 BY -1 DO
  129.         IF Point & (name[j]='.') THEN name[j]:='?' END;
  130.         Point:=(Point OR (name[j]='.')) & (name[j]#'\')
  131.         (* leave only one '.' per (folder-)name *)
  132.       END;
  133.       Filename.GetDriveAndPath(Fn);
  134.       Filename.parse(name,F);
  135.       Fn.name:='*';
  136.       Filename.compose(F,Fn,name);
  137.       i:=0;
  138.       REPEAT
  139.         Wild:=(name[i]='*') OR (name[i]='?');
  140.         INC(i);
  141.       UNTIL (i>HIGH(name)) OR Wild OR (name[i]<=' '); 
  142.       IF ~Wild THEN Done:= TRUE; RETURN END;
  143.       Filename.parse(name,F);
  144.       Fn:=F;
  145.       IF (Fn.name[0]='*')&(Fn.name[1]=NUL) THEN Fn.name:='TEST' END;
  146.       Filename.SelectFilename(F,Fn,Done);
  147.       Done:=~Done;
  148.       Filename.compose(Fn,Fn,name);
  149.     END ReqName;
  150.  
  151.   PROCEDURE ConvFromStr (       s : ARRAY OF CHAR;
  152.                           VAR res : LONGCARD;
  153.                               max : LONGCARD;
  154.                               neg : BOOLEAN;
  155.                          VAR Done : BOOLEAN);
  156.   VAR L,b : CARDINAL;
  157.   BEGIN
  158.     L:=Length(s);
  159.     Done:=L>0;
  160.     IF Done THEN
  161.       CASE s[L-1] OF
  162.         'H': b:=10H; s[L-1]:=NUL; |
  163.         'C': b:=10B; s[L-1]:=NUL; |
  164.         'B': b:=10B; s[L-1]:=NUL; |
  165.       ELSE
  166.         b:=10; s[L]:=NUL
  167.       END;
  168.       Conversions.ConvertFromString(s,b,neg,max,res,Done)
  169.     END
  170.   END ConvFromStr;
  171.  
  172.   TYPE ReadyProc = PROCEDURE() : BOOLEAN;
  173.   
  174.   PROCEDURE Ready(R : ReadyProc) : BOOLEAN;
  175.     VAR n : CARDINAL;
  176.     BEGIN
  177.       n:=0;
  178.       REPEAT
  179.         IF R() THEN RETURN TRUE END;
  180.         INC(n)
  181.       UNTIL n=10000;
  182.       RETURN FALSE
  183.     END Ready;
  184.  
  185.   PROCEDURE OpenInput (name : ARRAY OF CHAR );
  186.   BEGIN
  187.     CloseInput; (* close current In *)
  188.     IF Done THEN
  189.       IF    equ("CON:",name) THEN 
  190.         In:=CON; 
  191.         Done:=TRUE           
  192.       ELSIF equ("AUX:",name) THEN 
  193.         Done:=Ready(GEMDOS.AuxIS);
  194.         IF Done THEN In:=AUX END           
  195.       ELSIF equ("PRN:",name) THEN 
  196.         Done:=FALSE  (* no input from PRN *)                    
  197.       ELSE
  198.         ReqName(name);
  199.         FileSystem.Lookup(InFile,name,FALSE);
  200.         Done:=InFile.length>LONG(0);
  201.         IF ~Done THEN FileSystem.Delete(InFile) ELSE In:=FILE END
  202.       END
  203.     END;
  204.     IF ~Done THEN (* select default In *) In:=CON END 
  205.   END OpenInput;
  206.  
  207.   PROCEDURE OpenOutput ( name : ARRAY OF CHAR );
  208.   BEGIN
  209.     CloseOutput;
  210.     IF Done THEN
  211.       IF    equ("CON:",name) THEN 
  212.         Out:=CON; 
  213.         Done:=TRUE 
  214.       ELSIF equ("AUX:",name) THEN 
  215.         Done:=Ready(GEMDOS.AuxOS);
  216.         IF Done THEN Out:=AUX END
  217.       ELSIF equ("PRN:",name) THEN 
  218.         Done:=Ready(GEMDOS.PrnOS);
  219.         IF Done THEN Out:=PRN END
  220.       ELSE
  221.          ReqName(name);
  222.          FileSystem.Lookup(OutFile,name,TRUE);
  223.          Out:=FILE
  224.        END
  225.     END;
  226.     IF ~Done THEN (* select default Out *) Out:=CON END
  227.   END OpenOutput;
  228.  
  229.   PROCEDURE CloseInput;
  230.   VAR reply : INTEGER;
  231.   BEGIN
  232.     IF Out=FILE THEN FileSystem.Close(OutFile) END;
  233.     In:=CON;  (* return In to default value *)
  234.     Done:=TRUE
  235.   END CloseInput;
  236.  
  237.   PROCEDURE CloseOutput;
  238.   VAR reply : INTEGER;
  239.   BEGIN
  240.     CASE Out OF
  241.       AUX..PRN: WriteLn;                  | (* Empties the buffer *)
  242.       FILE:     FileSystem.Close(OutFile) |    
  243.     ELSE
  244.     END;
  245.     Done:=TRUE;
  246.     Out:=CON (* return Out to default value *)
  247.   END CloseOutput;
  248.  
  249.   PROCEDURE Read(VAR ch : CHAR);
  250.   BEGIN
  251.     CASE In OF
  252.       FILE: Done:=~InFile.eof;
  253.             IF Done THEN FileSystem.ReadChar(InFile,ch) END; |
  254.       CON:  Terminal.Read(ch);                               |
  255.       AUX:  Done:=Ready(GEMDOS.AuxIS);
  256.             IF Done THEN GEMDOS.AuxIn(ch) END;               |
  257.       PRN:  Done:=FALSE
  258.     END;
  259.     IF ~Done THEN ch:=NUL END
  260.   END Read;
  261.  
  262.   PROCEDURE ReadString ( VAR s : ARRAY OF CHAR );
  263.   VAR i : INTEGER; (* index of s *)
  264.   BEGIN
  265.     RdStr(s, i, string (* select ReadString *) )
  266.   END ReadString;
  267.  
  268.   PROCEDURE ReadLine ( VAR s : ARRAY OF CHAR );
  269.   VAR i : INTEGER; (* index of s *)
  270.   BEGIN
  271.     RdStr(s, i, line (* select ReadLine *) );
  272.     s[i]:=NUL; (* to make s compatible to WriteString *)
  273.     termCH:=NUL
  274.   END ReadLine;
  275.  
  276.   PROCEDURE ReadInt ( VAR x : INTEGER );
  277.   VAR S : String;
  278.       res : RECORD
  279.               CASE : BOOLEAN OF
  280.                 TRUE : C : LONGCARD |
  281.                 FALSE: I : LONGINT
  282.               END
  283.             END;
  284.   BEGIN
  285.     ReadString(S);
  286.     IF Done THEN
  287.       ConvFromStr( S, res.C, MAX(INTEGER), TRUE, Done);
  288.       IF Done THEN x:=SHORT(res.I) END
  289.     END
  290.       (* convert S, terminated by termCH, to Integer x and report success *)
  291.   END ReadInt;
  292.  
  293.   PROCEDURE ReadCard ( VAR x : CARDINAL );
  294.   VAR S : String;
  295.       res : LONGCARD;
  296.   BEGIN
  297.     ReadString(S);
  298.     IF Done THEN
  299.       ConvFromStr( S, res, MAX(CARDINAL), FALSE, Done);
  300.       IF Done THEN x:=SHORT(res) END
  301.     END
  302.      (* convert S, terminated by termCH, to Cardinal x and report success *)
  303.   END ReadCard;
  304.  
  305.   PROCEDURE Write ( ch : CHAR );
  306.   BEGIN
  307.     CASE Out OF
  308.       FILE: FileSystem.WriteChar(OutFile,ch);
  309.             Done:=TRUE;                         |
  310.       AUX : Done:=Ready(GEMDOS.AuxOS);
  311.             IF Done THEN GEMDOS.AuxOut(ch) END; |
  312.       CON : Terminal.Write(ch); 
  313.             Done:=TRUE;                         |
  314.       PRN : Done:=Ready(GEMDOS.PrnOS);
  315.             IF Done THEN GEMDOS.PrnOut(ch) END
  316.     END
  317.   END Write;
  318.  
  319.   PROCEDURE WriteLn;
  320.   BEGIN
  321.     Write(CR);
  322.     Write(LF)
  323.   END WriteLn;
  324.  
  325.   PROCEDURE WriteString ( s : ARRAY OF CHAR );
  326.   VAR i : INTEGER;
  327.   BEGIN
  328.     i:=0;
  329.     WHILE (i<=HIGH(s))&(s[i]#NUL)
  330.       (* stop writing if s is exhausted or "default termCH" is found *)
  331.     DO
  332.       IF s[i]>=" " (* s[i] is printable *) THEN Write(s[i]) END;
  333.       INC(i) (* next index *)
  334.     END
  335.   END WriteString;
  336.  
  337.   PROCEDURE WriteStringRight ( s : ARRAY OF CHAR ; n : INTEGER);
  338.   VAR L : INTEGER;
  339.   BEGIN
  340.     L:=Length(s);
  341.     IF n>L THEN
  342.       IF n>HIGH(s) THEN n:=HIGH(s) END;
  343.       INC(n); INC(L);
  344.       WHILE L>0 DO s[n-1]:=s[L-1]; DEC(n); DEC(L) END;
  345.       WHILE n>0 DO s[n-1]:=' ';    DEC(n)         END
  346.     END;
  347.     WriteString(s)
  348.   END WriteStringRight;
  349.  
  350.   PROCEDURE WriteInt ( x : INTEGER ; n : CARDINAL );
  351.   VAR S     : String;
  352.       Dummy : BOOLEAN;
  353.     BEGIN
  354.     Conversions.ConvertToString(ABS(x),10,x<0,S,Dummy);
  355.       (* convert integer x to string S *)
  356.     WriteStringRight(S,n)
  357.   END WriteInt;
  358.  
  359.   PROCEDURE WriteCard ( x, n : CARDINAL );
  360.   VAR S     : String;
  361.       Dummy : BOOLEAN;
  362.   BEGIN
  363.     Conversions.ConvertToString(x,10,FALSE,S,Dummy);
  364.       (* convert cardinal x to string S *)
  365.     WriteStringRight(S,n)
  366.   END WriteCard;
  367.  
  368.   PROCEDURE WriteOct ( x, n : CARDINAL );
  369.   VAR S     : String;
  370.       L     : CARDINAL;
  371.       Dummy : BOOLEAN;
  372.   BEGIN
  373.     Conversions.ConvertToString(x,10B,FALSE,S,Dummy);
  374.     L:=Length(S);
  375.     S[L]  :='B';
  376.     S[L+1]:=NUL;
  377.       (* convert cardinal x to string S (octal) *)
  378.     WriteStringRight(S,n)
  379.   END WriteOct;
  380.  
  381.   PROCEDURE WriteHex ( x, n : CARDINAL );
  382.   VAR S     : String;
  383.       L     : CARDINAL;
  384.       Dummy : BOOLEAN;
  385.   BEGIN
  386.     Conversions.ConvertToString(x,10H,FALSE,S,Dummy);
  387.     L:=Length(S);
  388.     S[L]  :='H';
  389.     S[L+1]:=NUL;
  390.       (* convert cardinal x to string S (Hexadecimal) *)
  391.     WriteStringRight(S,n)
  392.   END WriteHex;
  393.        
  394. BEGIN
  395.  
  396.   In := CON; Out := CON; (* Initialise In=keyboard and Out=screen *)
  397.  
  398. END (* IMPLEMENTATION MODULE *) InOut.
  399.